perm filename BB.F4[RST,LCS] blob
sn#244652 filedate 1976-10-27 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DIMENSION BARS(1),JBAR(1),JRN(1),MBAR(1)
C00009 ENDMK
Cā;
DIMENSION BARS(1),JBAR(1),JRN(1),MBAR(1)
DATA QLINE/140.0/,HX/2./,SLSP/11.0/,DIV/4./
C QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
COMMON/STF/RSTFAC(-3/4),RSTJ2 /SIZE/SIZE
COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
1/PX/KPN(300) /Q/Q(2001) /PTR/KWDS(300) /XRN/RN(2000)/NBAR/NBAR(36)
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000))
1,(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
C TRNSP'S Bb, F, BBb, A, G, Eb.
145 FORMAT(F,2I)
CALL GETFIL('BARS')
CALL FASTIN(KBAR,512)
CALL FASTIN(RSTFAC,128)
2000 TYPE 144,RSTJ2
144 FORMAT(' STAFF SIZE='F4.2,' CHANGE TO '$)
ACCEPT 145,SIZE,LL
IF(SIZE.NE.0)GO TO 101
SIZE=1
101 DO 22 K=1,KT
22 JBAR(K)=BARS(K)*SIZE+.5
TOT=TOT*SIZE
33 IF(RSTJ2.EQ.0)RSTJ2=1
RA=JPG*SIZE*RSTJ2
MPG=10./RA
C MPG=NUM OF BRACES PER PAGE.
SPG=10./MPG
C SPG IS SPACE TO BE SET ABOVE STAFF 0
RA=(RSTJ2*SIZE)/RPSZ(1)
DO 141 K=1,JPG
141 RPSZ(K)=RPSZ(K)*RA
LPG=JPG
140 TYPE 90,KT
RA=0
90 FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
JT=TOT/QLINE
C USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
16 NT=JT
L=0
JTOT=TOT+.5
KAV=JTOT/NT
LMAX=10000
NBAR(1)=1
J=1
3 M=1
JAV=JTOT/NT
IF(JAV.GT.KAV)JAV=JAV-2
IF(JAV.LT.KAV)JAV=JAV+2
K=JBAR(J)
1 J=J+1
IF(J.GT.KT)GO TO 2
N=JBAR(J)
IF(K+N/2.GE.JAV)GO TO 2
M=M+1
K=K+N
GO TO 1
2 L=L+1
JTOT=JTOT-K
NT=NT-1
JRN(L)=K
NBAR(L+1)=J
IF(NT.NE.0)GO TO 3
5 MAX=0
MIN=10000
NBAR(JT+1)=KT+1
DO 7 L=1,JT
K=JRN(L)
IF(K.LE.MAX)GO TO 6
MAX=K
MX=L
6 IF(K.GE.MIN)GO TO 7
MIN=K
MN=L
7 CONTINUE
IF(MAX.GE.LMAX)GO TO 9
LMAX=MAX
DO 8 J=1,JT+1
C SAVE NBAR INFO IN MBAR
8 MBAR(J)=NBAR(J)
IF(MX.LT.MN)GO TO 32
23 K=NBAR(MX)
C NEXT RIPPLES THE BARS FROM FRONT TO BACK.
MM=JBAR(K)
JRN(MX)=JRN(MX)-MM
JRN(MX-1)=JRN(MX-1)+MM
NBAR(MX)=K+1
MX=MX-1
IF(MX.GT.MN)GO TO 23
GO TO 34
32 K=NBAR(MX+1)-1
MM=JBAR(K)
JRN(MX)=JRN(MX)-MM
JRN(MX+1)=JRN(MX+1)+MM
NBAR(MX+1)=K
MX=MX+1
IF(MX.LT.MN)GO TO 32
34 GO TO 5
CC34 JJ=1
L=1
37 N=0
M=L
L=L+1
35 N=N+JBAR(JJ)
IF(N.EQ.JRN(M))GO TO 36
JJ=JJ+1
GO TO 35
36 NBAR(L)=JJ+1
IF(L.LT.JT)GO TO 37
GO TO 5
C* GO BACK AND FIND MAX AGAIN.
9 MBAR(JT+1)=KT+1
DO 10 K=1,JT
N=MBAR(K)
M=MBAR(K+1)
NBAR(K)=N
JRN(K)=0
DO 10 J=N,M-1
10 JRN(K)=JRN(K)+JBAR(J)
13 DO 11 L=2,JT
K=NBAR(L)
MM=JRN(L)
KK=JRN(L-1)
IF(MM.GE.KK)GO TO 12
C JUGGLES ADJACENT LINES
N=JBAR(K-1)
IF(KK-MM.LT.N)GO TO 11
JRN(L-1)=KK-N
JRN(L)=MM+N
NBAR(L)=K-1
GO TO 13
12 N=JBAR(K)
IF(MM-KK.LE.N)GO TO 11
JRN(L-1)=KK+N
JRN(L)=MM-N
NBAR(L)=K+1
GO TO 13
11 CONTINUE
46 J=1
JTOT=TOT+.5
JAV=JTOT/JT
TYPE 306,JAV
PRINT 306,JAV
DO 305 K=1,JT
NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
L=NBAR(K)-1+J
306 FORMAT(I5,3X8I5)
TYPE 306,JRN(K),(JBAR(N),N=J,L)
PRINT 306,JRN(K),(JBAR(N),N=J,L)
305 J=L+1
NBAR(JT+1)=0
RPG=JT
RPG=RPG/MPG
105 TYPE 104,RPG,JT
PRINT 104,RPG,JT
104 FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
C FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
KA=0
ACCEPT 145,T,N,KL
C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
JT=T
IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.
END